home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2001 May / SGI Freeware 2001 May - Disc 1.iso / dist / fw_teTeX.idb / usr / freeware / bin / thumbpdf.z / thumbpdf
Text File  |  2001-01-10  |  15KB  |  586 lines
  1. eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
  2.   if 0;
  3. use strict;
  4. #
  5. # thumbpdf.pl
  6. #
  7. # Copyright (C) 1999 Heiko Oberdiek.
  8. #
  9. # This program may be distributed and/or modified under the
  10. # conditions of the LaTeX Project Public License, either version 1.2
  11. # of this license or (at your option) any later version.
  12. # The latest version of this license is in
  13. #   http://www.latex-project.org/lppl.txt
  14. # and version 1.2 or later is part of all distributions of LaTeX
  15. # version 1999/12/01 or later.
  16. #
  17. # See file "readme.txt" for a list of files that belong to this project.
  18. #
  19. # This file "thumbpdf.pl" may be renamed to "thumbpdf"
  20. # for installation purposes.
  21. #
  22. my $file        = "thumbpdf.pl";
  23. my $program     = uc($file =~ /^(\w+)/, $1);
  24. my $version     = "1.11";
  25. my $date        = "2000/01/19";
  26. my $author      = "Heiko Oberdiek";
  27. my $copyright   = "Copyright (c) 1999 by $author.";
  28. #
  29. # Reqirements: Perl5, Ghostscript
  30. # History:
  31. #   1999/02/14 v1.0: First release.
  32. #   1999/02/23 v1.1:
  33. #    * Looking for the media box to calculate the resolution
  34. #      for ghostscript
  35. #    * new option --resolution
  36. #   1999/03/01 v1.2:
  37. #    * optimization: indirect objects for length values removed.
  38. #    * "first line" from epstopdf
  39. #   1999/03/12 v1.3:
  40. #    * Copyright: LPPL
  41. #   1999/05/05 v1.4:
  42. #    * Detecting of cygwin32 environment.
  43. #    * Minor corrections of output of error messages.
  44. #    * Sharing RGB objects.
  45. #   1999/06/13 v1.5:
  46. #    * gs detection extended.
  47. #   1999/07/27 v1.6
  48. #   1999/08/08 v1.7:
  49. #    * \immediate before \pdfobj (pdfTeX 0.14a)
  50. #   1999/09/09 v1.8
  51. #   1999/09/06 v1.9:
  52. #    * Check for direct /Length values (for jpg images)
  53. #   2000/01/11 v1.10:
  54. #    * Bug fix: /Length (direct) as last entry.
  55. #    * Direct /Length in RGB objects supported.
  56. #   2000/01/19 v1.11:
  57. #    * "for (my $j=0;...;...)"  replaced by "my $j; for($j=0;...;...)",
  58. #      because there exist perl versions that have problems with.
  59. #
  60.  
  61. ### program identification
  62. my $title = "$program $version, $date - $copyright\n";
  63.  
  64. ### error strings
  65. my $Error = "!!! Error:"; # error prefix
  66.  
  67. ### string constants for ghostscript run
  68. # get ghostscript command name
  69. my $GS = "gs";
  70. $GS = "gs386"    if $^O =~ /dos/i;
  71. $GS = "gsos2"    if $^O =~ /os2/i;
  72. $GS = "gswin32c" if $^O =~ /mswin32/i;
  73. $GS = "gswin32c" if $^O =~ /cygwin/i;
  74.  
  75. ### file names
  76. my $dtafile = "thumbdta.tex";
  77. my $optfile = "thumbopt.tex";
  78. my $pdffile = "thumbpdf.pdf";
  79. my $texfile = "thumbpdf";
  80. my $package = "thumbpdf.sty";
  81.  
  82. ### usage
  83. my @bool = ("false", "true");
  84. $::opt_device="png16m";
  85. $::opt_compress="9";
  86. $::opt_resolution="";
  87. my $resolution=9;
  88. $::opt_help=0;
  89. $::opt_quiet=0;
  90. $::opt_debug=0;
  91. $::opt_verbose=0;
  92. $::opt_makepng=1;
  93. $::opt_makepdf=1;
  94. $::opt_makedef=1;
  95.  
  96. my $usage = <<"END_OF_USAGE";
  97. ${title}Syntax:   \L$program\E [options] [pdf file]
  98. Function:
  99.   1. If a pdf file is given, make thumbnails  (ghostscript --> thumb???.png).
  100.   2. Make pdf file with thumb nails as images (pdftex      --> $pdffile).
  101.   3. Parse pdf file and generate a tex input file        ( --> $dtafile),
  102.      that is read by package '$package'.
  103. Options:
  104.   --help          print usage
  105.   --(no)makepng   perform step one   (default: $bool[$::opt_makepng])
  106.   --(no)makepdf   perform step two   (default: $bool[$::opt_makepdf])
  107.   --(no)makedef   perform step three (default: $bool[$::opt_makedef])
  108.   --(no)quiet     suppress messages  (default: $bool[$::opt_quiet])
  109.   --(no)verbose   verbose printing   (default: $bool[$::opt_verbose])
  110.   --(no)debug     debug informations while parsing         (default: $bool[$::opt_debug])
  111.   --resolution <res>       resolution for ghostscript step (default: $resolution)
  112.   --compress <n>           <n>   = 0..9
  113.                   \\pdfcompresslevel for '$pdffile'     (default: $::opt_compress)
  114.   --device|png [png]<dev>  <dev> = mono, gray, 16, 256, 16m
  115.                   ghostscript png device                   (default: $::opt_device)
  116. END_OF_USAGE
  117.  
  118. ### process options
  119. use Getopt::Long;
  120. GetOptions(
  121.   "help!",
  122.   "quiet!",
  123.   "debug!",
  124.   "verbose!",
  125.   "device|png=s",
  126.   "compress=i",
  127.   "resolution=f",
  128.   "makepng!",
  129.   "makepdf!",
  130.   "makedef!"
  131. ) or die $usage;
  132. !$::opt_help or die $usage;
  133. @ARGV < 2 or die "$usage$Error Too many files!\n";
  134.  
  135. $::opt_device = "png$::opt_device" unless $::opt_device =~ /^png/;
  136. $::opt_quiet = 0 if $::opt_verbose;
  137.  
  138. ### get pdf file name
  139. my $jobpdffile;
  140. if (@ARGV == 1)
  141. {
  142.   $jobpdffile = $ARGV[0];
  143.   $jobpdffile .= '.pdf' if -f "$jobpdffile.pdf";
  144.   -f $jobpdffile or die "$usage$Error PDF file '$jobpdffile' not found!\n";
  145. }
  146.  
  147. print $title unless $::opt_quiet;
  148.  
  149. print "* ghostscript command: '$GS'\n" if $::opt_verbose;
  150. print "* ghostscript png device: '$::opt_device'\n" if $::opt_verbose;
  151.  
  152. ###
  153. ### make thumbnails
  154. ###
  155. if ($::opt_makepng and $jobpdffile)
  156. {
  157.   print "*** make png files / run ghostscript ***\n" unless $::opt_quiet;
  158.   print "* pdf file: $jobpdffile\n" if $::opt_verbose;
  159.  
  160.   if ($::opt_resolution)
  161.   {
  162.     $resolution = $::opt_resolution
  163.   }
  164.   else
  165.   {
  166.     # looking for MediaBox
  167.  
  168.     my $max_x = 0;
  169.     my $max_y = 0;
  170.     {
  171.       my $MB = $jobpdffile;
  172.       open(MB, $MB) or die "$Error Cannot open '$MB'!\n";
  173.       binmode(MB);
  174.       my $xy_patt = '[\-\.\d]';
  175.       while (<MB>)
  176.       {
  177.         if (/\/MediaBox\s*\[\s*($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s*\]/)
  178.         {
  179.           my $x = $3 - $1;
  180.           my $y = $4 - $2;
  181.           $max_x = $x if $x > $max_x;
  182.           $max_y = $y if $y > $max_y;
  183.         }
  184.       }
  185.       close(MB);
  186.     }
  187.     if ($max_x <= 0 || $max_y <= 0)
  188.     {
  189.       print "!!! Warning: MediaBox not found, " .
  190.             "using default resolution: $resolution DPI\n";
  191.     }
  192.     else
  193.     {
  194.       print "* Max. Size of MediaBox: $max_x x $max_y\n" if $::opt_verbose;
  195.  
  196.       my $rx = 106 * 72 / $max_x;
  197.       my $ry = 106 * 72 / $max_y;
  198.       $resolution = $rx;
  199.       $resolution = $ry if $ry < $rx;
  200.       print "* Resolution: $resolution DPI\n" if $::opt_verbose;
  201.     }
  202.   }
  203.  
  204.   my $gs_cmd = <<"GS_CMD_END";
  205. $GS
  206. -dNOPAUSE
  207. -dBATCH
  208. -sDEVICE=$::opt_device
  209. -r$resolution
  210. -sOutputFile=thumb%03d.png
  211. $jobpdffile
  212. GS_CMD_END
  213.   chomp($gs_cmd);
  214.   $gs_cmd =~ s/\n/ /mg;
  215.   print "> $gs_cmd\n" if $::opt_verbose;
  216.   my $capture = `$gs_cmd`;
  217.   print $capture if $::opt_verbose;
  218.   if ($capture =~ /Error:\s*(.*)\n/)
  219.   {
  220.     die "$Error \"$1\" (ghostscript)!\n";
  221.   }
  222.   if ($capture =~ /Unknown device:\s*(.*)\n/)
  223.   {
  224.     die "$Error Unknown device \"$1\" (ghostscript)!\n";
  225.   }
  226.   if ($? != 0)
  227.   {
  228.     die "$Error $? (ghostscript)!\n";
  229.   }
  230. }
  231.  
  232. ###
  233. ### make thumbpdf.pdf file
  234. ###
  235. if ($::opt_makepdf)
  236. {
  237.   print "*** make \"$pdffile\" / run pdftex ***\n" unless $::opt_quiet;
  238.  
  239.   # get max thumb number to speed up the pdftex run
  240.   my $MaxThumb = 0;
  241.   foreach (glob("thumb???.png"))
  242.   {
  243.     next unless /thumb(\d\d\d).png/;
  244.     $MaxThumb = $1 if $1 > $MaxThumb;
  245.   }
  246.  
  247.   my $cmd = "pdftex \"\\nonstopmode\\pdfcompresslevel$::opt_compress" .
  248.     "\\def\\thumbmax{$MaxThumb}\\input $texfile\"";
  249.   print "> $cmd\n" if $::opt_verbose;
  250.   my @capture = `$cmd`;
  251.   if ($::opt_verbose)
  252.   {
  253.     print @capture if $::opt_verbose;
  254.   }
  255.   else
  256.   {
  257.     foreach (@capture)
  258.     {
  259.       print if /^!\s/;
  260.     }
  261.   }
  262.   if ($?)
  263.   {
  264.     die "$Error $? (pdftex)!\n";
  265.   }
  266. }
  267.  
  268. ###
  269. ### parse thumbpdf.pdf to make thumbdta.tex
  270. ###
  271.  
  272. if ($::opt_makedef)
  273. {
  274.   print "*** parse \"$pdffile\" ***\n" unless $::opt_quiet;
  275.  
  276. ### reading file and parse obj structure
  277.  
  278.   my @objno = (); # obj number
  279.   my @objdict = (); # boolean, object is dict
  280.   my @objtext = (); # text of object
  281.   my @objstream = (); # stream of object if any
  282.   my $maxobj = 0;
  283.  
  284.   my @getobjindex = (); # $getobj[obj number] ==> index for $obj...[index]
  285.  
  286.   # open file
  287.   my $PDF = $pdffile;
  288.   open(PDF, $PDF) or die "$Error Cannot open '$PDF'!\n";
  289.   binmode(PDF);
  290.   my $lineno = 0;
  291.  
  292.   # read header
  293.   $_ = <PDF>; $lineno++;
  294.   $_ or die "$Error Cannot read header of '$PDF'!\n";
  295.   /^%PDF/ or die "$Error No PDF specification found!\n";
  296.   print "* pdf header: $_" if ($::opt_debug);
  297.  
  298.   # read body objects
  299.   my $count = 0;
  300.   while (<PDF>)
  301.   {
  302.     $lineno++;
  303.  
  304.     # stop at xref
  305.     last if /^xref$/;
  306.  
  307.     # scan first obj line
  308.     /^(\d+)\s+0\s+obj\s*(<<)?$/ or
  309.       die "$Error 'obj' expected on line $lineno!\n";
  310.     $objno[$count] = $1;
  311.     $getobjindex[$1] = $count;
  312.     $objdict[$count] = ($2); # boolean (if $2 exists)
  313.     my $stream = 0;
  314.     print "* obj $objno[$count]" .
  315.       (($objdict[$count]) ? " (dict)" : "") .
  316.       "\n" if $::opt_debug;
  317.  
  318.     # get obj
  319.     $objtext[$count] = "";
  320.     while (<PDF>)
  321.     {
  322.       $lineno++;
  323.  
  324.       if ($objdict[$count])
  325.       {
  326.         if (/^>>/)
  327.         {
  328.           last if /^>>\s+endobj$/; # obj without stream
  329.  
  330.           # get stream
  331.           $_ = <PDF>; $lineno++;
  332.           /^stream$/ or die "$Error 'stream' expected on line $lineno!\n";
  333.  
  334.           print "* stream\n" if $::opt_debug;
  335.           $objstream[$count] = "";
  336.           while (<PDF>)
  337.           {
  338.             $lineno++;
  339.  
  340.             if (/(.*)endstream$/)
  341.             {
  342.               $objstream[$count] .= $1;
  343.               last;
  344.             }
  345.             $objstream[$count] .= $_;
  346.           }
  347.  
  348.           $_ = <PDF>; $lineno++;
  349.           /^endobj$/ or die "$Error 'endobj' expected on line $lineno!\n";
  350.           last;
  351.         }
  352.       }
  353.       else # no dict
  354.       {
  355.         last if /^endobj$/;
  356.       }
  357.       $objtext[$count] .= $_;
  358.     }
  359.     $count++;
  360.   }
  361.   close(PDF);
  362.   $maxobj = $count;
  363.   print "* $maxobj objects found.\n" if $::opt_debug;
  364.  
  365. ### get thumbnail page numbers
  366.   my @thumbpageno = ();
  367.   my $found = 0;
  368.   foreach (@objtext)
  369.   {
  370.     if (/^\/ListThumbs\s+(.+)$/)
  371.     {
  372.       $_ = $1;
  373.       chomp;
  374.       @thumbpageno = split / /; # split(/ /, $_);
  375.       print "* ListThumbs: @thumbpageno\n" if $::opt_debug;
  376.       $found = 1;
  377.       last;
  378.     }
  379.   }
  380.   $found or die "$Error '/ListThumbs' not found!\n";
  381.   {
  382.     my $j;
  383.     for ($j=0; $j<@thumbpageno; $j++)
  384.     {
  385.       $thumbpageno[$j] = $1 if $thumbpageno[$j] =~ /^{(.+)}$/;
  386.     }
  387.   }
  388.  
  389. ### identify thumb objects
  390.  
  391.   my @thumbobj = ();    # index for @obj... with image stream
  392.   my @thumblength = (); # stream length values
  393.   my @thumbrgbobj = (); # index for @obj... with rgb stream
  394.   my @thumbrgblength = (); # rgb stream length values
  395.   my $maxthumb = 0;
  396.  
  397.   $count = 0;
  398.   my $i;
  399.   for ($i=0; $i<$maxobj; $i++)
  400.   {
  401.     if ($objtext[$i] =~
  402.         /^\/Type\s+\/XObject\n\/Subtype\s+\/Image\n/m)
  403.     {
  404.       $thumbobj[$count] = $i;
  405.       $_ = $';
  406.       $objtext[$i] = $_;
  407.  
  408.       # check width and height
  409.       /\/Width\s+(\d+)\n\/Height\s+(\d+)/m or
  410.         die "$Error width/height of thumbnail not found!\n";
  411.       print "* Size: $1x$2\n" if $::opt_debug;
  412.       print "!!! Caution: Width ($1) too large, not recommanded for Acrobat Reader 3.x!\n"
  413.         if $1 > 106;
  414.       print "!!! Caution: Height ($2) too large, not recommanded for Acrobat Reader 3.x!\n"
  415.         if $2 > 106;
  416.  
  417.       # get stream length
  418.       if (/\/Length\s+(\d+)\s+([\/\>]|$)/m)
  419.       {
  420.         $thumblength[$count] = $1;
  421.         print "* Length (direct): $1\n" if $::opt_debug;
  422.         # object text remains unchanged.
  423.       }
  424.       else # looking for indirect reference
  425.       {
  426.         /\/Length\s+(\d+)\s+0\s+R/m or
  427.           die "$Error '/Length' entry not found!\n";
  428.         # save obj text for later correction
  429.         my $objpre = $`;
  430.         my $objpost = $';
  431.         # look for length obj
  432.         $getobjindex[$1] or die "$Error Length obj not found!\n";
  433.         $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
  434.           die "$Error length value not found!\n";
  435.         $thumblength[$count] = $1;
  436.         print "* Length (indirect): $1\n" if $::opt_debug;
  437.         # insert obj length directly:
  438.         $objtext[$i] = $objpre . "/Length $1" . $objpost;
  439.       }
  440.  
  441.       # check /Indexed /DeviceRGB
  442.       if ($objtext[$i] =~
  443.         /\/ColorSpace\s+\[\/Indexed\s+\/DeviceRGB\s+(\d+)\s+(\d+)\s+0\s+R\]/m)
  444.       {
  445.         # correct thumb object text
  446.         $objtext[$i] =
  447.           "$`/ColorSpace [/Indexed /DeviceRGB $1 \\the\\pdflastobj\\ 0 R]$'";
  448.         # get RGB obj number
  449.         $getobjindex[$2] or die "$Error RGB object not found!\n";
  450.         $_ = $getobjindex[$2];
  451.         $thumbrgbobj[$count] = $_;
  452.         # get stream length
  453.         if ($objtext[$_] =~ /\/Length\s+(\d+)\s+([\/\>]|$)/m)
  454.         {
  455.           $thumbrgblength[$count] = $1;
  456.           print "* RGB length (direct): $1\n" if $::opt_debug;
  457.         }
  458.         else # looking for indirect reference
  459.         {
  460.           $objtext[$_] =~ /\/Length\s+(\d+)\s+0\s+R/m or
  461.             die "$Error Length entry of rgb object not found\n";
  462.           # save obj text for later correction
  463.           my $objrgbpre = $`;
  464.           my $objrgbpost = $';
  465.           # get rgb stream length
  466.           $getobjindex[$1] or die "$Error RGB length object not found!\n";
  467.           $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
  468.             die "$Error length value not found!\n";
  469.           $thumbrgblength[$count] = $1;
  470.           print "* RGB length (indirect): $1\n" if $::opt_debug;
  471.           # insert RGB object length directly:
  472.           $objtext[$_] = $objrgbpre . "/Length $1" . $objrgbpost;
  473.         }
  474.       }
  475.  
  476.       $count++;
  477.     }
  478.   }
  479.   $maxthumb = $count;
  480.  
  481.   if ($maxthumb != @thumbpageno)
  482.   {
  483.     my $pagecount = @thumbpageno;
  484.     die "$Error $maxthumb thumbnails found, but there should be $pagecount!\n";
  485.   }
  486.   print "* $maxthumb thumbnails found.\n" if $::opt_verbose;
  487.  
  488.  
  489. ###
  490. ### write "thumbdta.tex"
  491. ###
  492.  
  493.   print "*** write \"$dtafile\" ***\n" unless $::opt_quiet;
  494.  
  495.   my $TEX = $dtafile;
  496.   open(TEX, ">$TEX") or die "!!! Error: Cannot open '$TEX'!\n";
  497.   binmode(TEX);
  498.  
  499.   for ($i=0; $i<$maxthumb; $i++)
  500.   {
  501.     # rgb object
  502.     if ($thumbrgbobj[$i])
  503.     {
  504.       $objtext[$thumbrgbobj[$i]] =~ s/\n/^^J%\n/mg;
  505.  
  506.       # find the same rgb object
  507.       my $j;
  508.       for ($j=0; $j<$i; $j++)
  509.       {
  510.         next unless $thumbrgbobj[$j];
  511.         next unless $objtext[$thumbrgbobj[$j]] eq
  512.                     $objtext[$thumbrgbobj[$i]];
  513.         next unless $objstream[$thumbrgbobj[$j]] eq
  514.                     $objstream[$thumbrgbobj[$i]];
  515.         last;
  516.       }
  517.       if ($j==$i) # not found
  518.       {
  519.         my $rgbstream = convertstream($objstream[$thumbrgbobj[$i]]);
  520.         print TEX <<"END_TEX";
  521. \\immediate\\pdfobj{<<^^J%
  522. $objtext[$thumbrgbobj[$i]]>>^^J%
  523. stream^^J%
  524. $rgbstream%
  525. endstream}%
  526. \\DefRGB{$i}%
  527. END_TEX
  528.       }
  529.       else # $j with same rgb obj
  530.       {
  531.         $objtext[$thumbobj[$i]] =~
  532.           s/\\the\\pdflastobj/\\UseRGB{$j}/;
  533.         print "* Reuses RGB object $j for $i\n" if $::opt_debug;
  534.       }
  535.     }
  536.  
  537.     # thumb object
  538.     $objtext[$thumbobj[$i]] =~ s/\n/^^J%\n/mg;
  539.     my $stream = convertstream($objstream[$thumbobj[$i]]);
  540.     print TEX <<"END_TEX";
  541. \\immediate\\pdfobj{<<^^J%
  542. $objtext[$thumbobj[$i]]>>^^J%
  543. stream^^J%
  544. $stream%
  545. endstream}%
  546. \\DefThumb{$thumbpageno[$i]}%
  547. END_TEX
  548.   }
  549.  
  550.   print TEX "\\endinput%\n";
  551.   close(TEX);
  552. }
  553.  
  554. sub convertstream
  555. {
  556.   my @ch = split(//, $_[0]);
  557.   my $str = "";
  558.   my $mod = 0;
  559.   foreach (@ch)
  560.   {
  561.     my $num = vec($_, 0, 8);
  562.     if    (/ /)  { $_ = '\\ '; }
  563.     elsif (/%/)  { $_ = '\\%'; }
  564.     elsif (/\\/) { $_ = '\\\\'; }
  565.     elsif (/\^/) { $_ = '\\+'; }
  566.     elsif (/{/)  { $_ = '\\{'; }
  567.     elsif (/}/)  { $_ = '\\}'; }
  568.     elsif ($num == 13) { $_ = '\\/'; }
  569.     elsif ($num < 32 || $num >= 127) {
  570.       $_ = sprintf("^^%02x", $num);
  571.     }
  572.     $str .= $_;
  573.     $mod++;
  574.     if ($mod == 16)
  575.     {
  576.       $mod = 0;
  577.       $str .= "%\n";
  578.     }
  579.   }
  580.   return $str;
  581. }
  582.  
  583. print "*** ready. ***\n" unless $::opt_quiet;
  584.  
  585. __END__
  586.